home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / faq-s.zip / EXECSWAP.PAS < prev    next >
Pascal/Delphi Source File  |  1989-07-19  |  4KB  |  124 lines
  1. {
  2. Copyright (c) 1988 TurboPower Software
  3. May be used freely as long as due credit is given
  4. Version 1.1 - 3/15/89
  5.   save and restore EMS page map
  6. Version 1.2 - 3/29/89
  7.   add more compiler directives (far calls off, boolean short-circuiting)
  8.   add UseEmsIfAvailable to disable EMS usage when desired
  9. }
  10.  
  11. {$R-,S-,F-,O-,I-,B-}
  12.  
  13. unit ExecSwap;
  14.   {-Memory-efficient DOS EXEC call}
  15. interface
  16. const
  17.   UseEmsIfAvailable : Boolean = True;     {True to use EMS if available}
  18.   BytesSwapped : LongInt = 0;             {Bytes to swap to EMS/disk}
  19.   EmsAllocated : Boolean = False;         {True when EMS allocated for swap}
  20.   FileAllocated : Boolean = False;        {True when file allocated for swap}
  21.  
  22. function ExecWithSwap(Path, CmdLine : String) : Word;
  23.   {-DOS EXEC supporting swap to EMS or disk}
  24.  
  25. function InitExecSwap(LastToSave : Pointer; SwapFileName : String) : Boolean;
  26.   {-Initialize for swapping, returning TRUE if successful}
  27.  
  28. procedure ShutdownExecSwap;
  29.   {-Deallocate swap area}
  30.  
  31. implementation
  32.  
  33. var
  34.   EmsHandle : Word;               {Handle of EMS allocation block}
  35.   FrameSeg : Word;                {Segment of EMS page frame}
  36.   FileHandle : Word;              {DOS handle of swap file}
  37.   SwapName : String[80];          {ASCIIZ name of swap file}
  38.   SaveExit : Pointer;             {Exit chain pointer}
  39.  
  40.   {$L EXECSWAP}
  41.   function ExecWithSwap(Path, CmdLine : String) : Word; external;
  42.   procedure FirstToSave; external;
  43.   function AllocateSwapFile : Boolean; external;
  44.   procedure DeallocateSwapFile; external;
  45.  
  46.   {$F+}     {These routines could be interfaced for general use}
  47.   function EmsInstalled : Boolean; external;
  48.   function EmsPageFrame : Word; external;
  49.   function AllocateEmsPages(NumPages : Word) : Word; external;
  50.   procedure DeallocateEmsHandle(Handle : Word); external;
  51.   function DefaultDrive : Char; external;
  52.   function DiskFree(Drive : Byte) : LongInt; external;
  53.  
  54.   procedure ExecSwapExit;
  55.   begin
  56.     ExitProc := SaveExit;
  57.     ShutdownExecSwap;
  58.   end;
  59.   {$F-}
  60.  
  61.   procedure ShutdownExecSwap;
  62.   begin
  63.     if EmsAllocated then begin
  64.       DeallocateEmsHandle(EmsHandle);
  65.       EmsAllocated := False;
  66.     end else if FileAllocated then begin
  67.       DeallocateSwapFile;
  68.       FileAllocated := False;
  69.     end;
  70.   end;
  71.  
  72.   function PtrDiff(H, L : Pointer) : LongInt;
  73.   type
  74.     OS = record O, S : Word; end;   {Convenient typecast}
  75.   begin
  76.     PtrDiff := (LongInt(OS(H).S) shl 4+OS(H).O)-
  77.                (LongInt(OS(L).S) shl 4+OS(L).O);
  78.   end;
  79.  
  80.   function InitExecSwap(LastToSave : Pointer;
  81.                         SwapFileName : String) : Boolean;
  82.   const
  83.     EmsPageSize = 16384;            {Bytes in a standard EMS page}
  84.   var
  85.     PagesInEms : Word;              {Pages needed in EMS}
  86.     BytesFree : LongInt;            {Bytes free on swap file drive}
  87.     DriveChar : Char;               {Drive letter for swap file}
  88.   begin
  89.     InitExecSwap := False;
  90.  
  91.     if EmsAllocated or FileAllocated then
  92.       Exit;
  93.     BytesSwapped := PtrDiff(LastToSave, @FirstToSave);
  94.     if BytesSwapped <= 0 then
  95.       Exit;
  96.     SaveExit := ExitProc;
  97.     ExitProc := @ExecSwapExit;
  98.  
  99.     if UseEmsIfAvailable and EmsInstalled then begin
  100.       PagesInEms := (BytesSwapped+EmsPageSize-1) div EmsPageSize;
  101.       EmsHandle := AllocateEmsPages(PagesInEms);
  102.       if EmsHandle <> $FFFF then begin
  103.         EmsAllocated := True;
  104.         FrameSeg := EmsPageFrame;
  105.         if FrameSeg <> 0 then begin
  106.           InitExecSwap := True;
  107.           Exit;
  108.         end;
  109.       end;
  110.     end;
  111.     if Length(SwapFileName) <> 0 then begin
  112.       SwapName := SwapFileName+#0;
  113.       if Pos(':', SwapFileName) = 2 then
  114.         DriveChar := Upcase(SwapFileName[1])
  115.       else
  116.         DriveChar := DefaultDrive;
  117.       BytesFree := DiskFree(Byte(DriveChar)-$40);
  118.       FileAllocated := (BytesFree > BytesSwapped) and AllocateSwapFile;
  119.       if FileAllocated then
  120.         InitExecSwap := True;
  121.     end;
  122.   end;
  123. end.
  124.